home *** CD-ROM | disk | FTP | other *** search
/ Complete Linux / Complete Linux.iso / docs / apps / circuits / spice2g6.z / spice2g6 / spice / Fortran / runcon.f < prev    next >
Encoding:
Text File  |  1989-02-03  |  20.1 KB  |  689 lines
  1.       subroutine runcon(id)
  2.       implicit double precision (a-h,o-z)
  3. c
  4. c     this routine processes run control cards.
  5. c
  6. c spice version 2g.6  sccsid=tabinf 3/15/83
  7.       common /tabinf/ ielmnt,isbckt,nsbckt,iunsat,nunsat,itemps,numtem,
  8.      1   isens,nsens,ifour,nfour,ifield,icode,idelim,icolum,insize,
  9.      2   junode,lsbkpt,numbkp,iorder,jmnode,iur,iuc,ilc,ilr,numoff,isr,
  10.      3   nmoffc,iseq,iseq1,neqn,nodevs,ndiag,iswap,iequa,macins,lvnim1,
  11.      4   lx0,lvn,lynl,lyu,lyl,lx1,lx2,lx3,lx4,lx5,lx6,lx7,ld0,ld1,ltd,
  12.      5   imynl,imvn,lcvn,nsnod,nsmat,nsval,icnod,icmat,icval,
  13.      6   loutpt,lpol,lzer,irswpf,irswpr,icswpf,icswpr,irpt,jcpt,
  14.      7   irowno,jcolno,nttbr,nttar,lvntmp
  15. c spice version 2g.6  sccsid=cje 3/15/83
  16.       common /cje/ maxtim,itime,icost
  17. c spice version 2g.6  sccsid=miscel 3/15/83
  18.       common /miscel/ atime,aprog(3),adate,atitle(10),defl,defw,defad,
  19.      1  defas,rstats(50),iwidth,lwidth,nopage
  20. c spice version 2g.6  sccsid=cirdat 3/15/83
  21.       common /cirdat/ locate(50),jelcnt(50),nunods,ncnods,numnod,nstop,
  22.      1   nut,nlt,nxtrm,ndist,ntlin,ibr,numvs,numalt,numcyc
  23. c spice version 2g.6  sccsid=status 3/15/83
  24.       common /status/ omega,time,delta,delold(7),ag(7),vt,xni,egfet,
  25.      1   xmu,sfactr,mode,modedc,icalc,initf,method,iord,maxord,noncon,
  26.      2   iterno,itemno,nosolv,modac,ipiv,ivmflg,ipostp,iscrch,iofile
  27. c spice version 2g.6  sccsid=flags 3/15/83
  28.       common /flags/ iprnta,iprntl,iprntm,iprntn,iprnto,limtim,limpts,
  29.      1   lvlcod,lvltim,itl1,itl2,itl3,itl4,itl5,itl6,igoof,nogo,keof
  30. c spice version 2g.6  sccsid=knstnt 3/15/83
  31.       common /knstnt/ twopi,xlog2,xlog10,root2,rad,boltz,charge,ctok,
  32.      1   gmin,reltol,abstol,vntol,trtol,chgtol,eps0,epssil,epsox,
  33.      2   pivtol,pivrel
  34. c spice version 2g.6  sccsid=dc 3/15/83
  35.       common /dc/ tcstar(2),tcstop(2),tcincr(2),icvflg,itcelm(2),kssop,
  36.      1   kinel,kidin,kovar,kidout
  37. c spice version 2g.6  sccsid=ac 3/15/83
  38.       common /ac/ fstart,fstop,fincr,skw2,refprl,spw2,jacflg,idfreq,
  39.      1   inoise,nosprt,nosout,nosin,idist,idprt
  40. c spice version 2g.6  sccsid=tran 3/15/83
  41.       common /tran/ tstep,tstop,tstart,delmax,tdmax,forfre,jtrflg
  42. c spice version 2g.6  sccsid=outinf 3/15/83
  43.       common /outinf/ xincr,string(15),xstart,yvar(8),itab(8),itype(8),
  44.      1   ilogy(8),npoint,numout,kntr,numdgt
  45. c spice version 2g.6  sccsid=debug 3/15/83
  46.       common/debug/ idebug(20)
  47. c spice version 2g.6  sccsid=blank 3/15/83
  48.       common /blank/ value(200000)
  49.       integer nodplc(64)
  50.       complex cvalue(32)
  51.       equivalence (value(1),nodplc(1),cvalue(1))
  52.       dimension iprnt(5),limits(4),itrlim(6),contol(6),dflts(4)
  53.       equivalence (iprnt(1),iprnta),(limits(1),limtim),(itrlim(1),itl1),
  54.      1   (contol(1),gmin),(dflts(1),defl)
  55. c
  56. c
  57.       integer xxor
  58. c
  59. c  print/plot keywords
  60. c
  61.       dimension aopt(5)
  62.       dimension aopts(34),lsetop(5)
  63.       dimension aide(20)
  64.       data aopt / 2hdc, 2htr, 2hac, 2hno, 2hdi /
  65. c
  66. c  options card keywords
  67. c
  68.       data aopts / 6hacct  , 6hlist  , 6hnomod , 6hnode  , 6hopts  ,
  69.      1             6hitl1  , 6hitl2  , 6hitl3  , 6hitl4  , 6hitl5  ,
  70.      2             6hitl6  , 6hlimtim, 6hlimpts, 6hlvlcod, 6hlvltim,
  71.      3             6hgmin  , 6hreltol, 6habstol, 6hvntol , 6htrtol ,
  72.      4             6hchgtol, 6htnom  , 6hnumdgt, 6hmaxord, 6hmethod,
  73.      5             6hnopage, 6hmu    , 6hcptime, 6hdefl  , 6hdefw  ,
  74.      6             6hdefad , 6hdefas , 6hpivtol, 6hpivrel /
  75.       data lsetop / 1 ,1, 0, 1, 1 /
  76. c
  77. c
  78.       data aide / 1hr,1hc,1hl,1hk,1hg,1he,1hf,1hh,1hv,1hi,1hd,1hq,1hj,
  79.      1   1hm,1hs,1hy,1ht,4htemp,1hx,0.0d0 /
  80.       data alsde,alsoc,alsli / 3hdec, 3hoct, 3hlin /
  81.       data atrap, agear, auic / 4htrap, 4hgear, 3huic /
  82.       data ablnk, ain, aout / 1h , 2hin, 3hout /
  83.       data amiss / 8h*missing /
  84.       data ams / 2hms /
  85.       data minpts / 1 /
  86. c
  87. c
  88.       go to (1200,1100,1650,6000,6000,1700,6000,1600,1550,2000,3600,
  89.      1   3500,6000,1750,1300,1500,1800,4000,4100,4200,5900), id
  90. c
  91. c  dc transfer curves
  92. c
  93.  1100 ifld=2
  94.       icvflg=0
  95.       inum=1
  96.  1105 anam=value(ifield+ifld)
  97.       if(inum.gt.2) go to 6000
  98.       id=0
  99.       call move(anam,2,ablnk,1,7)
  100.       if (anam.eq.aide(1)) id=1
  101.       if (anam.eq.aide(9)) id=9
  102.       if (anam.eq.aide(10)) id=10
  103.       if (anam.eq.aide(17)) go to 1108
  104.       if (id.eq.0) go to 1130
  105.       call find(value(ifield+ifld),id,itcelm(inum),0)
  106.       go to 1115
  107.  1108 anam=value(ifield+ifld)
  108.       call move(anam,5,ablnk,1,4)
  109.       if (anam.ne.aide(18)) go to 1130
  110.       id=18
  111.       call find(anam,id,itcelm(inum),1)
  112.       locs=nodplc(itcelm(inum)+1)
  113.       nodplc(itcelm(inum)+2)=0
  114.       value(locs)=anam
  115.       value(locs+1)=value(itemps+1)
  116.       call extmem(itemps,2)
  117.       value(itemps+2)=value(itemps+1)
  118.  1115 ifld=ifld+1
  119.       if (nodplc(icode+ifld).ne.0) go to 1130
  120.       tcstar(inum)=value(ifield+ifld)
  121.       ifld=ifld+1
  122.       if (nodplc(icode+ifld).ne.0) go to 1130
  123.       tcstop(inum)=value(ifield+ifld)
  124.       ifld=ifld+1
  125.       if (nodplc(icode+ifld).ne.0) go to 1130
  126.       tcincr(inum)=value(ifield+ifld)
  127.       if (tcincr(inum).eq.0.0d0) go to 1130
  128.       temp=(tcstop(inum)-tcstar(inum))/tcincr(inum)
  129.       if (temp.gt.0.0d0) go to 1110
  130.       tcincr(inum)=-tcincr(inum)
  131.       temp=-temp
  132.  1110 itemp=idint(temp+0.5d0)+1
  133.       itemp=max0(itemp,minpts)
  134.       if(inum.eq.1) icvflg=itemp
  135.       if(inum.eq.2) icvflg=itemp*icvflg
  136.       ifld=ifld+1
  137.       inum=2
  138.       if(nodplc(icode+ifld)) 6000,1130,1105
  139.  1130 write (iofile,1131)
  140.       icvflg=0
  141.  1131 format('0warning:  missing parameter(s) ... analysis omitted'/)
  142.       go to 6000
  143. c
  144. c  frequency specification
  145. c
  146.  1200 ifld=2
  147.       if (nodplc(icode+2)) 1250,1250,1210
  148.  1210 id=0
  149.       if (value(ifield+ifld).eq.alsde) id=1
  150.       if (value(ifield+ifld).eq.alsoc) id=2
  151.       if (value(ifield+ifld).eq.alsli) id=3
  152.       if (id.eq.0) go to 1240
  153.       idfreq=id
  154.       ifld=ifld+1
  155.       if (nodplc(icode+ifld).ne.0) go to 1250
  156.       if (value(ifield+ifld).le.0.0d0) go to 1250
  157.       fincr=value(ifield+ifld)
  158.       ifld=ifld+1
  159.       if (nodplc(icode+ifld).ne.0) go to 1250
  160.       if (value(ifield+ifld).le.0.0d0) go to 1250
  161.       fstart=value(ifield+ifld)
  162.       ifld=ifld+1
  163.       if (nodplc(icode+ifld).ne.0) go to 1250
  164.       if (value(ifield+ifld).le.0.0d0) go to 1250
  165.       fstop=value(ifield+ifld)
  166.       if (fstart.gt.fstop) go to 1260
  167.       jacflg=fincr
  168.       if (idfreq-2) 1215,1220,1235
  169.  1215 fincr=dexp(xlog10/fincr)
  170.       go to 1230
  171.  1220 fincr=dexp(xlog2/fincr)
  172.  1230 temp=dlog(fstop/fstart)/dlog(fincr)
  173.       jacflg=idint(temp+0.999d0)+1
  174.  1235 jacflg=max0(jacflg,minpts)
  175.       if (idfreq.ne.3) go to 6000
  176.       fincr=(fstop-fstart)/dble(max0(jacflg-1,1))
  177.       go to 6000
  178.  1240 write (iofile,1241) value(ifield+ifld)
  179.  1241 format('0warning:  unknown frequency function:  ',a8,' ... analys'
  180.      1   ,'is omitted'/)
  181.       go to 6000
  182.  1250 write (iofile,1251)
  183.  1251 format('0warning:  frequency parameters incorrect ... analysis om'
  184.      1   ,'itted'/)
  185.       go to 6000
  186.  1260 write (iofile,1261)
  187.  1261 format('0warning:  start freq > stop freq ... analysis omitted'/)
  188.       go to 6000
  189. c
  190. c  time specification
  191. c
  192.  1300 ifld=2
  193.       if (nodplc(icode+ifld).ne.0) go to 1430
  194.       if (value(ifield+ifld).le.0.0d0) go to 1430
  195.       tstep=value(ifield+ifld)
  196.       ifld=ifld+1
  197.       if (nodplc(icode+ifld).ne.0) go to 1430
  198.       if (value(ifield+ifld).le.0.0d0) go to 1430
  199.       tstop=value(ifield+ifld)
  200.       tstart=0.0d0
  201.       delmax=tstop/50.0d0
  202.       ifld=ifld+1
  203.       if (nodplc(icode+ifld).ne.0) go to 1310
  204.       if (value(ifield+ifld).lt.0.0d0) go to 1430
  205.       tstart=value(ifield+ifld)
  206.       delmax=(tstop-tstart)/50.0d0
  207.       ifld=ifld+1
  208.       if (nodplc(icode+ifld).ne.0) go to 1310
  209.       if (value(ifield+ifld).le.0.0d0) go to 1430
  210.       delmax=value(ifield+ifld)
  211.       ifld=ifld+1
  212.  1310 if (nodplc(icode+ifld).ne.1) go to 1320
  213.       if (value(ifield+ifld).ne.auic) go to 1320
  214.       nosolv=1
  215.  1320 if (tstart.gt.tstop) go to 1440
  216.       if (tstep.gt.tstop) go to 1430
  217.       jtrflg=idint((tstop-tstart)/tstep+0.5d0)+1
  218.       jtrflg=max0(jtrflg,minpts)
  219.       go to 6000
  220.  1430 write (iofile,1431)
  221.  1431 format('0warning:  time parameters incorrect ... analysis omitted'
  222.      1   /)
  223.       go to 6000
  224.  1440 write (iofile,1441)
  225.  1441 format('0warning:  start time > stop time ... analysis omitted'/)
  226.       go to 6000
  227. c
  228. c  transfer function
  229. c
  230.  1500 kssop=1
  231.       ifld=2
  232.       if (nodplc(icode+ifld).ne.1) go to 1530
  233.       call outdef(ifld,1,kovar,ktype)
  234.       if (igoof.ne.0) go to 1530
  235.       if (ktype.ne.1) go to 1540
  236.       ifld=ifld+1
  237.       if (nodplc(icode+ifld).ne.1) go to 1530
  238.       anam=value(ifield+ifld)
  239.       call move(anam,2,ablnk,1,7)
  240.       id=0
  241.       if (anam.eq.aide(9)) id=9
  242.       if (anam.eq.aide(10)) id=10
  243.       if (id.eq.0) go to 1530
  244.       call find(value(ifield+ifld),id,kinel,0)
  245.       kidin=id
  246.       go to 6000
  247.  1530 kovar=0
  248.       kinel=0
  249.       write (iofile,1131)
  250.       igoof=0
  251.       go to 6000
  252.  1540 kovar=0
  253.       kinel=0
  254.       write (iofile,1541)
  255.  1541 format('0warning:  illegal output variable ... analysis omitted'/)
  256.       igoof=0
  257.       go to 6000
  258. c
  259. c  operating point
  260. c
  261.  1550 kssop=1
  262.       go to 6000
  263. c
  264. c  noise analysis
  265. c
  266.  1600 ifld=2
  267.       if (nodplc(icode+ifld).ne.1) go to 1610
  268.       call outdef(ifld,2,nosout,ntype)
  269.       if (igoof.ne.0) go to 1610
  270.       if (ntype.ne.1) go to 1610
  271.       if (nodplc(nosout+5).ne.0) go to 1610
  272.       ifld=ifld+1
  273.       if (nodplc(icode+ifld).ne.1) go to 1620
  274.       anam=value(ifield+ifld)
  275.       call move(anam,2,ablnk,1,7)
  276.       id=0
  277.       if (anam.eq.aide(9)) id=9
  278.       if (anam.eq.aide(10)) id=10
  279.       if (id.eq.0) go to 1620
  280.       call find(value(ifield+ifld),id,nosin,0)
  281.       nosprt=0
  282.       ifld=ifld+1
  283.       if (nodplc(icode+ifld).ne.0) go to 1605
  284.       nosprt=dmax1(0.0d0,value(ifield+ifld))
  285.  1605 inoise=1
  286.       go to 6000
  287.  1610 write (iofile,1611)
  288.  1611 format('0warning:  voltage output unrecognizable ... analysis omit
  289.      1ted'/)
  290.       igoof=0
  291.       go to 6000
  292.  1620 write (iofile,1621)
  293.  1621 format('0warning:  invalid input source ... analysis omitted'/)
  294.       igoof=0
  295.       go to 6000
  296. c
  297. c  distortion analysis
  298. c
  299.  1650 ifld=2
  300.       if (nodplc(icode+ifld).ne.1) go to 1660
  301.       anam=value(ifield+ifld)
  302.       call move(anam,2,ablnk,1,7)
  303.       if (anam.ne.aide(1)) go to 1660
  304.       call find(value(ifield+ifld),1,idist,0)
  305.       idprt=0
  306.       skw2=0.9d0
  307.       refprl=1.0d-3
  308.       spw2=1.0d0
  309.       ifld=ifld+1
  310.       if (nodplc(icode+ifld).ne.0) go to 6000
  311.       idprt=value(ifield+ifld)
  312.       idprt=max0(idprt,0)
  313.       ifld=ifld+1
  314.       if (nodplc(icode+ifld).ne.0) go to 6000
  315.       if (value(ifield+ifld).le.0.001d0) go to 1670
  316.       if (value(ifield+ifld).gt.0.999d0) go to 1670
  317.       skw2=value(ifield+ifld)
  318.       ifld=ifld+1
  319.       if (nodplc(icode+ifld).ne.0) go to 6000
  320.       if (value(ifield+ifld).lt.1.0d-10) go to 1670
  321.       refprl=value(ifield+ifld)
  322.       ifld=ifld+1
  323.       if (nodplc(icode+ifld).ne.0) go to 6000
  324.       if (value(ifield+ifld).lt.0.001d0) go to 1670
  325.       spw2=value(ifield+ifld)
  326.       go to 6000
  327.  1660 write (iofile,1661)
  328.  1661 format('0warning:  distortion load resistor missing ... analysis '
  329.      1   ,'omitted'/)
  330.       go to 6000
  331.  1670 idist=0
  332.       write (iofile,1671)
  333.  1671 format('0warning:  distortion parameters incorrect ... analysis o'
  334.      1   ,'mitted'/)
  335.       go to 6000
  336. c
  337. c  fourier analysis
  338. c
  339.  1700 ifld=2
  340.       if (nodplc(icode+ifld).ne.0) go to 1720
  341.       if (value(ifield+ifld).le.0.0d0) go to 1720
  342.       forfre=value(ifield+ifld)
  343.  1705 ifld=ifld+1
  344.       if (nodplc(icode+ifld).ne.1) go to 1710
  345.       call outdef(ifld,2,loct,ltype)
  346.       if (igoof.ne.0) go to 1720
  347.       if (ltype.ne.1) go to 1720
  348.       call extmem(ifour,1)
  349.       nfour=nfour+1
  350.       nodplc(ifour+nfour)=loct
  351.       go to 1705
  352.  1710 if (nfour.ge.1) go to 6000
  353.  1720 write (iofile,1721)
  354.  1721 format('0warning:  fourier parameters incorrect ... analysis omit'
  355.      1   ,'ted'/)
  356.       igoof=0
  357.       nfour=0
  358.       call clrmem(ifour)
  359.       call getm4(ifour,0)
  360.       go to 6000
  361. c
  362. c  sensitivity analysis
  363. c
  364.  1750 kssop=1
  365.       ifld=1
  366.  1760 ifld=ifld+1
  367.       if (nodplc(icode+ifld).ne.1) go to 6000
  368.       call outdef(ifld,1,loct,ltype)
  369.       if (igoof.ne.0) go to 1780
  370.       if (ltype.ne.1) go to 1780
  371.       call extmem(isens,1)
  372.       nsens=nsens+1
  373.       nodplc(isens+nsens)=loct
  374.       go to 1760
  375.  1780 write (iofile,1781)
  376.  1781 format('0warning:  output variable unrecognizable ... analysis om'
  377.      1   ,'mitted'/)
  378.       igoof=0
  379.       nsens=0
  380.       call clrmem(isens)
  381.       call getm4(isens,0)
  382.       go to 6000
  383. c
  384. c  temperature variation
  385. c
  386.  1800 ifld=1
  387.  1810 ifld=ifld+1
  388.       if (nodplc(icode+ifld).ne.0) go to 6000
  389.       if (value(ifield+ifld).le.-223.0d0) go to 1810
  390.       call extmem(itemps,1)
  391.       numtem=numtem+1
  392.       value(itemps+numtem)=value(ifield+ifld)
  393.       go to 1810
  394. c
  395. c  options card
  396. c
  397.  2000 ifld=1
  398.  2010 ifld=ifld+1
  399.  2020 if (nodplc(icode+ifld)) 6000,2010,2030
  400.  2030 anam=value(ifield+ifld)
  401.       do 2040 i=1,5
  402.       if (anam.ne.aopts(i)) go to 2040
  403.       iprnt(i)=lsetop(i)
  404.       ifld=ifld+1
  405.       if(nodplc(icode+ifld).ne.0) go to 2020
  406.       iprnt(i)=value(ifield+ifld)
  407.       go to 2010
  408.  2040 continue
  409.       if (anam.eq.aopts(25)) go to 2110
  410.       if (anam.eq.aopts(26)) go to 2120
  411.       if (anam.eq.aopts(27)) go to 2130
  412.       if (anam.eq.aopts(28)) go to 2150
  413.       if (anam.eq.aopts(33)) go to 2200
  414.       if (anam.eq.aopts(34)) go to 2250
  415.       if (nodplc(icode+ifld+1).ne.0) go to 2510
  416.       ifld=ifld+1
  417.       aval=value(ifield+ifld)
  418.       do 2050 i=6,11
  419.       if (anam.ne.aopts(i)) go to 2050
  420.       if(aval.le.0.0d0.and.i.ne.10) go to 2510
  421.       itrlim(i-5)=aval
  422.       go to 2010
  423.  2050 continue
  424.       if (aval.le.0.0d0) go to 2510
  425.       do 2060 i=12,15
  426.       if (anam.ne.aopts(i)) go to 2060
  427.       limits(i-11)=aval
  428.       go to 2010
  429.  2060 continue
  430.       do 2070 i=16,21
  431.       if (anam.ne.aopts(i)) go to 2070
  432.       contol(i-15)=aval
  433.       go to 2010
  434.  2070 continue
  435.       do 2075 i=29,32
  436.       if(anam.ne.aopts(i)) go to 2075
  437.       dflts(i-28)=aval
  438.       go to 2010
  439.  2075 continue
  440.       if (anam.ne.aopts(22)) go to 2080
  441.       if (aval.lt.-223.0d0) go to 2510
  442.       value(itemps+1)=aval
  443.       go to 2010
  444.  2080 if (anam.ne.aopts(23)) go to 2100
  445.       ndigit=aval
  446.       if (ndigit.le.7) go to 2090
  447.       ndigit=7
  448.       write (iofile,2081) ndigit
  449.  2081 format('0warning:  numdgt may not exceed',i2,
  450.      1 ';  maximum value assumed'/)
  451.  2090 numdgt=ndigit
  452.       go to 2010
  453.  2100 if (anam.ne.aopts(24)) go to 2500
  454.       n=aval
  455.       if ((n.le.1).or.(n.ge.7)) go to 2510
  456.       maxord=n
  457.       go to 2010
  458.  2110 if (nodplc(icode+ifld+1).ne.1) go to 2510
  459.       ifld=ifld+1
  460.       anam=value(ifield+ifld)
  461.       call move(anam,5,ablnk,1,4)
  462.       jtype=0
  463.       if (anam.eq.atrap) jtype=1
  464.       if (anam.eq.agear) jtype=2
  465.       if (jtype.eq.0) go to 2510
  466.       method=jtype
  467.       go to 2010
  468.  2120 nopage=1
  469.       go to 2010
  470.  2130 ifld=ifld+1
  471.       if(nodplc(icode+ifld)) 6000,2140,2030
  472.  2140 aval=value(ifield+ifld)
  473.       if(aval.lt.0.0d0.or.aval.gt.0.500001d0) go to 2510
  474.       xmu=aval
  475.       go to 2010
  476.  2150 ifld=ifld+1
  477.       if(nodplc(icode+ifld)) 6000,2160,2030
  478.  2160 aval=value(ifield+ifld)
  479.       maxtim=aval
  480.       go to 2010
  481.  2200 ifld=ifld+1
  482.       if (nodplc(icode+ifld)) 6000,2210,2030
  483.  2210 aval=value(ifield+ifld)
  484.       if (aval.gt.1.0d0) go to 2510
  485.       pivtol=aval
  486.       go to 2010
  487.  2250 ifld=ifld+1
  488.       if (nodplc(icode+ifld)) 6000,2260,2030
  489.  2260 aval=value(ifield+ifld)
  490.       if (aval.gt.1.0d0) go to 2510
  491.       pivrel=aval
  492.       go to 2010
  493.  2500 write (iofile,2501) anam
  494.  2501 format('0warning:  unknown option:  ',a8,' ... ignored'/)
  495.       go to 2010
  496.  2510 write (iofile,2511) anam
  497.  2511 format('0warning:  illegal value specified for option:  ',a8,' ...
  498.      1 ignored'/)
  499.       go to 2010
  500. c
  501. c  print card
  502. c
  503.  3500 iprpl=0
  504.       go to 3610
  505. c
  506. c  plot (and print) card
  507. c
  508.  3600 iprpl=1
  509.  3610 ifld=2
  510.  3613 anam=amiss
  511.       if (nodplc(icode+ifld).ne.1) go to 3950
  512.       anam=value(ifield+ifld)
  513.       ms=0
  514.       if (xxor(anam,ams).ne.0) go to 3615
  515.       ms=1
  516.       ifld=3
  517.       if (nodplc(icode+ifld).ne.1) go to 3970
  518.       anam=value(ifield+ifld)
  519.  3615 call move(anam,3,ablnk,1,6)
  520.       do 3620 i=1,5
  521.       if (anam.ne.aopt(i)) go to 3620
  522.       ktype=i
  523.       go to 3630
  524.  3620 continue
  525.       go to 3950
  526.  3630 id=30+5*iprpl+ktype
  527.       call find(dble(jelcnt(id)),id,loc,1)
  528.       nodplc(loc+2)=ktype
  529.       if (ms.eq.0) go to 3635
  530.       locv=nodplc(loc+1)
  531.       value(locv)=0.0d0
  532.  3635 numout=0
  533.  3640 ifld=ifld+1
  534.       if (nodplc(icode+ifld)) 3900,3640,3650
  535.  3650 call outdef(ifld,ktype,loct,ltype)
  536.       if (igoof.ne.0) go to 3970
  537.       if (iprpl.eq.0) go to 3660
  538.       plimlo=0.0d0
  539.       plimhi=0.0d0
  540.       if (nodplc(icode+ifld+1).ne.0) go to 3660
  541.       if (nodplc(icode+ifld+2).ne.0) go to 3660
  542.       plimlo=value(ifield+ifld+1)
  543.       plimhi=value(ifield+ifld+2)
  544.       ifld=ifld+2
  545.  3660 numout=numout+1
  546.       lspot=loc+2*numout+2
  547.       nodplc(lspot)=loct
  548.       nodplc(lspot+1)=ltype
  549.       if (iprpl.eq.0) go to 3670
  550.       locv=nodplc(loc+1)
  551.       lspot=locv+2*numout-1
  552.       value(lspot)=plimlo
  553.       value(lspot+1)=plimhi
  554.  3670 if (numout.eq.8) go to 3900
  555.       go to 3640
  556.  3900 nodplc(loc+3)=numout
  557.       if (iprpl.eq.0) go to 6000
  558. c...  propogate plot limits downward
  559.       if (numout.le.1) go to 6000
  560.       locv=nodplc(loc+1)
  561.       lspot=locv+2*numout-1
  562.       plimlo=value(lspot)
  563.       plimhi=value(lspot+1)
  564.       i=numout-1
  565.  3905 lspot=lspot-2
  566.       if (value(lspot).ne.0.0d0) go to 3910
  567.       if (value(lspot+1).ne.0.0d0) go to 3910
  568.       value(lspot)=plimlo
  569.       value(lspot+1)=plimhi
  570.       go to 3920
  571.  3910 plimlo=value(lspot)
  572.       plimhi=value(lspot+1)
  573.  3920 i=i-1
  574.       if (i.ge.1) go to 3905
  575.       go to 6000
  576. c
  577. c     errors
  578. c
  579.  3950 write (iofile,3951) anam
  580.  3951 format('0warning:  unknown analysis mode:  ',a8,
  581.      1  ' ... line ignored'/)
  582.       go to 6000
  583.  3970 write (iofile,3971)
  584.  3971 format('0warning:  unrecognizable output variable on above line'/)
  585.       igoof=0
  586.       go to 3640
  587. c
  588. c  width card
  589. c
  590.  4000 ifld=1
  591.  4010 ifld=ifld+1
  592.       if (nodplc(icode+ifld).ne.1) go to 6000
  593.  4020 anam=value(ifield+ifld)
  594.       if (anam.ne.ain) go to 4040
  595.       ifld=ifld+1
  596.       if (nodplc(icode+ifld)) 6000,4030,4020
  597.  4030 iwidth=value(ifield+ifld)
  598.       iwidth=min0(max0(iwidth,10),120)
  599.       go to 4010
  600.  4040 if (anam.ne.aout) go to 6000
  601.       ifld=ifld+1
  602.       if (nodplc(icode+ifld)) 6000,4050,4020
  603.  4050 lwidth=dmin1(dmax1(value(ifield+ifld),72.0d0),132.0d0)
  604.       go to 4010
  605. c
  606. c  nodeset statement
  607. c
  608.  4100 ifld=1
  609.  4110 ifld=ifld+1
  610.       if(nodplc(icode+ifld)) 6000,4120,4110
  611.  4120 nodnum=value(ifield+ifld)
  612.       if(nodnum.le.0) go to 4190
  613.       ifld=ifld+1
  614.       if(nodplc(icode+ifld)) 4180,4130,4170
  615.  4130 call sizmem(nsnod,nic)
  616.       call extmem(nsnod,1)
  617.       call extmem(nsval,1)
  618.       nodplc(nsnod+nic+1)=nodnum
  619.       value(nsval+nic+1)=value(ifield+ifld)
  620.       go to 4110
  621. c
  622. c  errors on .nodeset statement
  623. c
  624.  4170 write(iofile,4171) value(ifield+ifld)
  625.  4171 format('0warning: out-of-place non-numeric field ',a8,
  626.      1 ' skipped'/)
  627.       go to 4110
  628.  4180 write(iofile,4181) nodnum
  629.  4181 format('0warning: initial value missing for node ',i5,/)
  630.       go to 6000
  631.  4190 write(iofile,4191)
  632.  4191 format('0warning: attempt to specify initial condition for ',
  633.      1 'ground ingnored',/)
  634.       ifld=ifld+1
  635.       if(nodplc(icode+ifld)) 6000,4110,4170
  636. c
  637. c  initial conditions statement
  638. c
  639.  4200 ifld=1
  640.  4210 ifld=ifld+1
  641.       if(nodplc(icode+ifld)) 6000,4220,4210
  642.  4220 nodnum=value(ifield+ifld)
  643.       if(nodnum.le.0) go to 4290
  644.       ifld=ifld+1
  645.       if(nodplc(icode+ifld)) 4280,4230,4270
  646.  4230 call sizmem(icnod,nic)
  647.       call extmem(icnod,1)
  648.       call extmem(icval,1)
  649.       nodplc(icnod+nic+1)=nodnum
  650.       value(icval+nic+1)=value(ifield+ifld)
  651.       go to 4210
  652. c
  653. c  errors on .ic statement
  654. c
  655.  4270 write(iofile,4271) value(ifield+ifld)
  656.  4271 format('0warning: out-of-place non-numeric field ',a8,
  657.      1 ' skipped'/)
  658.       go to 4210
  659.  4280 write(iofile,4281) nodnum
  660.  4281 format('0warning: initial value missing for node ',i5,/)
  661.       go to 6000
  662.  4290 write(iofile,4291)
  663.  4291 format('0warning: attempt to specify initial condition for ',
  664.      1 'ground ignored',/)
  665.       ifld=ifld+1
  666.       if(nodplc(icode+ifld)) 6000,4210,4270
  667. c
  668. c     :debug: statement
  669. c     sample debug line: .:debug: 5=3 17=5
  670. c
  671.  5900 ifld=1
  672.  5910 ifld=ifld+1
  673.       if (nodplc(icode+ifld)) 6000,5920,5910
  674.  5920 index=value(ifield+ifld)
  675.       ifld=ifld+1
  676.       if (nodplc(icode+ifld)) 6000,5930,5910
  677.  5930 ival=value(ifield+ifld)
  678.       if (index.lt.1) go to 5910
  679.       if (index.gt.20) go to 5910
  680.       write(iofile,5931) index,ival
  681.  5931 format(' *debug*:  runcon - idebug(',i2,') set to ',i10)
  682.       idebug(index)=ival
  683.       go to 5910
  684. c
  685. c  finished
  686. c
  687.  6000 return
  688.       end
  689.